home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / ab20 / ab20_archive / utilities / editors / emacs-18.58.lha / emacs / lisp / tags.el < prev    next >
Lisp/Scheme  |  1992-02-21  |  10KB  |  304 lines
  1. ;; Tags facility for Emacs.
  2. ;; Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. (provide 'tags)
  22.  
  23. (defvar tag-table-files nil
  24.   "List of file names covered by current tag table.
  25. nil means it has not been computed yet; do (tag-table-files) to compute it.")
  26.  
  27. (defvar last-tag nil
  28.   "Tag found by the last find-tag.")
  29.  
  30. (defun visit-tags-table (file)
  31.   "Tell tags commands to use tag table file FILE.
  32. FILE should be the name of a file created with the `etags' program.
  33. A directory name is ok too; it means file TAGS in that directory."
  34.   (interactive (list (read-file-name "Visit tags table: (default TAGS) "
  35.                      default-directory
  36.                      (concat default-directory "TAGS")
  37.                      t)))
  38.   (setq file (expand-file-name file))
  39.   (if (file-directory-p file)
  40.       (setq file (concat file "TAGS")))
  41.   (setq tag-table-files nil
  42.     tags-file-name file))
  43.  
  44. (defun visit-tags-table-buffer ()
  45.   "Select the buffer containing the current tag table.
  46. This is a file whose name is in the variable tags-file-name."
  47.   (or tags-file-name
  48.       (call-interactively 'visit-tags-table))
  49.   (set-buffer (or (get-file-buffer tags-file-name)
  50.           (progn
  51.             (setq tag-table-files nil)
  52.             (find-file-noselect tags-file-name))))
  53.   (or (verify-visited-file-modtime (get-file-buffer tags-file-name))
  54.       (cond ((yes-or-no-p "Tags file has changed, read new contents? ")
  55.          (revert-buffer t t)
  56.          (setq tag-table-files nil))))
  57.   (or (eq (char-after 1) ?\^L)
  58.       (error "File %s not a valid tag table" tags-file-name)))
  59.  
  60. (defun file-of-tag ()
  61.   "Return the file name of the file whose tags point is within.
  62. Assumes the tag table is the current buffer.
  63. File name returned is relative to tag table file's directory."
  64.   (let ((opoint (point))
  65.     prev size)
  66.     (save-excursion
  67.      (goto-char (point-min))
  68.      (while (< (point) opoint)
  69.        (forward-line 1)
  70.        (end-of-line)
  71.        (skip-chars-backward "^,\n")
  72.        (setq prev (point))
  73.        (setq size (read (current-buffer)))
  74.        (goto-char prev)
  75.        (forward-line 1)
  76.        (forward-char size))
  77.      (goto-char (1- prev))
  78.      (buffer-substring (point)
  79.                (progn (beginning-of-line) (point))))))
  80.  
  81. (defun tag-table-files ()
  82.   "Return a list of files in the current tag table.
  83. File names returned are absolute."
  84.   (save-excursion
  85.    (visit-tags-table-buffer)
  86.    (or tag-table-files
  87.        (let (files)
  88.     (goto-char (point-min))
  89.     (while (not (eobp))
  90.       (forward-line 1)
  91.       (end-of-line)
  92.       (skip-chars-backward "^,\n")
  93.       (setq prev (point))
  94.       (setq size (read (current-buffer)))
  95.       (goto-char prev)
  96.       (setq files (cons (expand-file-name
  97.                  (buffer-substring (1- (point))
  98.                            (save-excursion
  99.                          (beginning-of-line)
  100.                          (point)))
  101.                  (file-name-directory tags-file-name))
  102.                 files))
  103.       (forward-line 1)
  104.       (forward-char size))
  105.     (setq tag-table-files (nreverse files))))))
  106.  
  107. ;; Return a default tag to search for, based on the text at point.
  108. (defun find-tag-default ()
  109.   (save-excursion
  110.     (while (looking-at "\\sw\\|\\s_")
  111.       (forward-char 1))
  112.     (if (re-search-backward "\\sw\\|\\s_" nil t)
  113.     (progn (forward-char 1)
  114.            (buffer-substring (point)
  115.                  (progn (forward-sexp -1)
  116.                     (while (looking-at "\\s'")
  117.                       (forward-char 1))
  118.                     (point))))
  119.       nil)))
  120.  
  121. (defun find-tag-tag (string)
  122.   (let* ((default (find-tag-default))
  123.      (spec (read-string
  124.         (if default
  125.             (format "%s(default %s) " string default)
  126.           string))))
  127.     (list (if (equal spec "")
  128.           default
  129.         spec))))
  130.  
  131. (defun find-tag (tagname &optional next other-window)
  132.   "Find tag (in current tag table) whose name contains TAGNAME.
  133.  Selects the buffer that the tag is contained in
  134. and puts point at its definition.
  135.  If TAGNAME is a null string, the expression in the buffer
  136. around or before point is used as the tag name.
  137.  If second arg NEXT is non-nil (interactively, with prefix arg),
  138. searches for the next tag in the tag table
  139. that matches the tagname used in the previous find-tag.
  140.  
  141. See documentation of variable tags-file-name."
  142.   (interactive (if current-prefix-arg
  143.            '(nil t)
  144.          (find-tag-tag "Find tag: ")))
  145.   (let (buffer file linebeg startpos)
  146.     (save-excursion
  147.      (visit-tags-table-buffer)
  148.      (if (not next)
  149.      (goto-char (point-min))
  150.        (setq tagname last-tag))
  151.      (setq last-tag tagname)
  152.      (while (progn
  153.           (if (not (search-forward tagname nil t))
  154.           (error "No %sentries containing %s"
  155.              (if next "more " "") tagname))
  156.           (not (looking-at "[^\n\177]*\177"))))
  157.      (search-forward "\177")
  158.      (setq file (expand-file-name (file-of-tag)
  159.                   (file-name-directory tags-file-name)))
  160.      (setq linebeg
  161.        (buffer-substring (1- (point))
  162.                  (save-excursion (beginning-of-line) (point))))
  163.      (search-forward ",")
  164.      (setq startpos (read (current-buffer))))
  165.     (if other-window
  166.     (find-file-other-window file)
  167.       (find-file file))
  168.     (widen)
  169.     (push-mark)
  170.     (let ((offset 1000)
  171.       found
  172.       (pat (concat "^" (regexp-quote linebeg))))
  173.       (or startpos (setq startpos (point-min)))
  174.       (while (and (not found)
  175.           (progn
  176.            (goto-char (- startpos offset))
  177.            (not (bobp))))
  178.     (setq found
  179.           (re-search-forward pat (+ startpos offset) t))
  180.     (setq offset (* 3 offset)))
  181.       (or found
  182.       (re-search-forward pat nil t)
  183.       (error "%s not found in %s" pat file)))
  184.     (beginning-of-line))
  185.   (setq tags-loop-form '(find-tag nil t))
  186.   ;; Return t in case used as the tags-loop-form.
  187.   t)
  188.  
  189. (defun find-tag-other-window (tagname &optional next)
  190.   "Find tag (in current tag table) whose name contains TAGNAME.
  191.  Selects the buffer that the tag is contained in in another window
  192. and puts point at its definition.
  193.  If TAGNAME is a null string, the expression in the buffer
  194. around or before point is used as the tag name.
  195.  If second arg NEXT is non-nil (interactively, with prefix arg),
  196. searches for the next tag in the tag table
  197. that matches the tagname used in the previous find-tag.
  198.  
  199. See documentation of variable tags-file-name."
  200.   (interactive (if current-prefix-arg
  201.            '(nil t)
  202.            (find-tag-tag "Find tag other window: ")))
  203.   (find-tag tagname next t))
  204.  
  205. (defvar next-file-list nil
  206.   "List of files for next-file to process.")
  207.  
  208. (defun next-file (&optional initialize)
  209.   "Select next file among files in current tag table.
  210. Non-nil argument (prefix arg, if interactive)
  211. initializes to the beginning of the list of files in the tag table."
  212.   (interactive "P")
  213.   (if initialize
  214.       (setq next-file-list (tag-table-files)))
  215.   (or next-file-list
  216.       (error "All files processed."))
  217.   (find-file (car next-file-list))
  218.   (setq next-file-list (cdr next-file-list)))
  219.  
  220. (defvar tags-loop-form nil
  221.   "Form for tags-loop-continue to eval to process one file.
  222. If it returns nil, it is through with one file; move on to next.")
  223.  
  224. (defun tags-loop-continue (&optional first-time)
  225.   "Continue last \\[tags-search] or \\[tags-query-replace] command.
  226. Used noninteractively with non-nil argument
  227. to begin such a command.  See variable tags-loop-form."
  228.   (interactive)
  229.   (if first-time
  230.       (progn (next-file t)
  231.          (goto-char (point-min))))
  232.   (while (not (eval tags-loop-form))
  233.     (next-file)
  234.     (message "Scanning file %s..." buffer-file-name)
  235.     (goto-char (point-min))))
  236.  
  237. (defun tags-search (regexp)
  238.   "Search through all files listed in tag table for match for REGEXP.
  239. Stops when a match is found.
  240. To continue searching for next match, use command \\[tags-loop-continue].
  241.  
  242. See documentation of variable tags-file-name."
  243.   (interactive "sTags search (regexp): ")
  244.   (if (and (equal regexp "")
  245.        (eq (car tags-loop-form) 're-search-forward))
  246.       (tags-loop-continue nil)
  247.     (setq tags-loop-form
  248.       (list 're-search-forward regexp nil t))
  249.     (tags-loop-continue t)))
  250.  
  251. (defun tags-query-replace (from to &optional delimited)
  252.   "Query-replace-regexp FROM with TO through all files listed in tag table.
  253. Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
  254. If you exit (C-G or ESC), you can resume the query-replace
  255. with the command \\[tags-loop-continue].
  256.  
  257. See documentation of variable tags-file-name."
  258.   (interactive "sTags query replace (regexp): \nsTags query replace %s by: \nP")
  259.   (setq tags-loop-form
  260.     (list 'and (list 'save-excursion
  261.              (list 're-search-forward from nil t))
  262.           (list 'not (list 'perform-replace from to t t 
  263.                    (not (null delimited))))))
  264.   (tags-loop-continue t))
  265.  
  266. (defun list-tags (string)
  267.   "Display list of tags in file FILE.
  268. FILE should not contain a directory spec
  269. unless it has one in the tag table."
  270.   (interactive "sList tags (in file): ")
  271.   (with-output-to-temp-buffer "*Tags List*"
  272.     (princ "Tags in file ")
  273.     (princ string)
  274.     (terpri)
  275.     (save-excursion
  276.      (visit-tags-table-buffer)
  277.      (goto-char 1)
  278.      (search-forward (concat "\f\n" string ","))
  279.      (forward-line 1)
  280.      (while (not (or (eobp) (looking-at "\f")))
  281.        (princ (buffer-substring (point)
  282.                 (progn (skip-chars-forward "^\177")
  283.                        (point))))
  284.        (terpri)
  285.        (forward-line 1)))))
  286.  
  287. (defun tags-apropos (string)
  288.   "Display list of all tags in tag table REGEXP matches."
  289.   (interactive "sTag apropos (regexp): ")
  290.   (with-output-to-temp-buffer "*Tags List*"
  291.     (princ "Tags matching regexp ")
  292.     (prin1 string)
  293.     (terpri)
  294.     (save-excursion
  295.      (visit-tags-table-buffer)
  296.      (goto-char 1)
  297.      (while (re-search-forward string nil t)
  298.        (beginning-of-line)
  299.        (princ (buffer-substring (point)
  300.                 (progn (skip-chars-forward "^\177")
  301.                        (point))))
  302.        (terpri)
  303.        (forward-line 1)))))
  304.